home *** CD-ROM | disk | FTP | other *** search
/ MacTech 1 to 12 / MacTech-vol-1-12.toast / Source / MacTech® Magazine / Volume 04 - 1988 / 04.10 Oct 88 / Transfer DA Code Update / MDEF.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-01-20  |  10.0 KB  |  420 lines  |  [TEXT/MPS ]
  1. (*******************************************************************
  2.     
  3.     MDEF.pas
  4.     
  5.     Scrolling MDEF for Transfer DA.
  6.     
  7.     (c) 1988, 1989, by Clifford Story & Attic Software
  8.     
  9. *******************************************************************)
  10.     
  11. unit MDEF;
  12.     
  13. (******************************************************************)
  14.     
  15. interface
  16.     
  17. (******************************************************************)
  18.     
  19.     uses macintf, Common;
  20.     
  21. (******************************************************************)
  22.     
  23.     procedure menudef(message : integer; themenu : menuhandle;
  24.                     static menurect : rect; hitpoint : point;
  25.                     var whichitem : integer);
  26.     
  27. (******************************************************************)
  28.     
  29. implementation
  30.     
  31. (******************************************************************)
  32.     
  33.     const
  34.         
  35.         scrolldelay            =    6;
  36.         fixedlist            =    7;
  37.         
  38. (******************************************************************)
  39.     
  40.     procedure menudraw(themenu : menuhandle; static menurect : rect); forward;
  41.     procedure menuchoose(themenu : menuhandle; static menurect : rect;
  42.                     hitpoint : point; var theitem : integer); forward;
  43.     procedure menusize(themenu : menuhandle); forward;
  44.     
  45. (******************************************************************)
  46.     
  47.     function gethandle : thandle; external;
  48.     procedure sethandle(newhandle : point); external;
  49.     
  50.     function getoffset : integer; external;
  51.     procedure setoffset(newoffset : integer); external;
  52.     
  53.     function getsize : integer; external;
  54.     procedure setsize(newsize : integer); external;
  55.     
  56.     function getlength : integer; external;
  57.     procedure setlength(newlength : integer); external;
  58.     
  59.     function getflags : integer; external;
  60.     procedure setflags(newflags : integer); external;
  61.     
  62. (******************************************************************)
  63.     
  64.     procedure menudef(message : integer; themenu : menuhandle;
  65.                     static menurect : rect; hitpoint : point;
  66.                     var whichitem : integer);
  67.         
  68.         begin
  69.             
  70.             case message of
  71.                 mdrawmsg        :    menudraw(themenu, menurect);
  72.                 mchoosemsg    :    menuchoose(themenu, menurect,
  73.                                                     hitpoint, whichitem);
  74.                 msizemsg        :    menusize(themenu);
  75.                 msethandle    :    sethandle(hitpoint);
  76.             end;
  77.         
  78.         end;
  79.     
  80. (******************************************************************)
  81.     
  82.     procedure drawitem(themenu : menuhandle;
  83.                     theitem : integer; static itemrect: rect);
  84.         
  85.         var
  86.             height            :    integer;
  87.             width                :    integer;
  88.             thestring        :    str255;
  89.             thepoly            :    polyhandle;
  90.             dummy                :    integer;
  91.         
  92.         begin
  93.             
  94.             height := itemrect.top + 12;
  95.             width := itemrect.left + 12;
  96.             
  97.             if theitem > fixedlist then begin
  98.                 with gethandle^^.appl[theitem - fixedlist] do
  99.                     blockmove(@name, @thestring, 32);
  100.                 moveto(width, height);
  101.                 drawstring(thestring);
  102.             end else if theitem < 0 then begin
  103.                 
  104.                 thepoly := openpoly;
  105.                 
  106.                 if theitem = - 1 then begin
  107.                     moveto(width, height);
  108.                     dummy := - 6;
  109.                 end else if theitem = - 2 then begin
  110.                     moveto(width, height - 8);
  111.                     dummy := 6;
  112.                 end;
  113.                 
  114.                 line(6, dummy);
  115.                 line(6, - dummy);
  116.                 line(- 12, 0);
  117.                 
  118.                 closepoly;
  119.                 paintpoly(thepoly);
  120.                 killpoly(thepoly);
  121.                 
  122.             end else begin
  123.                 
  124.                 getitem(themenu, theitem, thestring);
  125.                 
  126.                 if thestring = '-' then begin
  127.                     moveto(itemrect.left, height);
  128.                     lineto(itemrect.right, height);
  129.                 end else begin
  130.                     moveto(width, height);
  131.                     drawstring(thestring);
  132.                 end;
  133.                 
  134.                 if (theitem = 5) and (getsize <= fixedlist) then begin
  135.                     penpat(QDglobals^.gray);
  136.                     penmode(patbic);
  137.                     paintrect(itemrect);
  138.                     pennormal;
  139.                 end;
  140.                 
  141.             end;
  142.         
  143.         end;
  144.     
  145. (******************************************************************)
  146.     
  147.     procedure menudraw(themenu: menuhandle; static menurect: rect);
  148.         
  149.         var
  150.             itemrect            :    rect;
  151.             index                :    integer;
  152.         
  153.         begin
  154.             
  155.             with menurect do
  156.                 setrect(itemrect, left, top, right, top + 16);
  157.             index := 1;
  158.             
  159.             while itemrect.bottom < menurect.bottom do begin
  160.                 drawitem(themenu, index, itemrect);
  161.                 itemrect.top := itemrect.bottom;
  162.                 itemrect.bottom := itemrect.bottom + 16;
  163.                 index := index + 1;
  164.             end;
  165.             
  166.             if getsize > index then begin
  167.                 drawitem(themenu, - 2, itemrect);
  168.                 setflags(2);
  169.             end else begin
  170.                 drawitem(themenu, index, itemrect);
  171.                 setflags(0);
  172.             end;
  173.             
  174.             setoffset(0);
  175.         
  176.         end;
  177.     
  178. (******************************************************************)
  179.     
  180.     procedure scrollmenu(themenu : menuhandle;
  181.                     static menurect : rect; direction : integer);
  182.         
  183.         var
  184.             thetime            :    long;
  185.             therect            :    rect;
  186.             theregion        :    rgnhandle;
  187.         
  188.         begin
  189.             
  190.             thetime := tickcount + scrolldelay;
  191.             
  192.             therect.left := menurect.left;
  193.             therect.right := menurect.right;
  194.             theregion := newrgn;
  195.             
  196.             if direction > 0 then begin
  197.                 
  198.                 if getflags = 1 then begin
  199.                     therect.top := menurect.bottom - 16;
  200.                     therect.bottom := menurect.bottom;
  201.                     eraserect(therect);
  202.                     drawitem(themenu, - 2, therect);
  203.                 end;
  204.                 
  205.                 therect.top := menurect.top + 16 * (fixedlist + 1);
  206.                 therect.bottom := menurect.bottom - 16;
  207.                 scrollrect(therect, 0, 16, theregion);
  208.                 
  209.                 therect := theregion^^.rgnbbox;
  210.                 disposergn(theregion);
  211.                 setoffset(getoffset - 1);
  212.                 
  213.                 drawitem(themenu, getoffset + fixedlist + 2, therect);
  214.                 if getoffset <> 0 then
  215.                     setflags(3)
  216.                 else begin
  217.                     therect.top := menurect.top + 16 * fixedlist;
  218.                     therect.bottom := therect.top + 16;
  219.                     eraserect(therect);
  220.                     drawitem(themenu, fixedlist + 1, therect);
  221.                     setflags(2);
  222.                 end;
  223.             
  224.             end else begin
  225.                 
  226.                 if getflags = 2 then begin
  227.                     therect.top := menurect.top + 16 * fixedlist;
  228.                     therect.bottom := therect.top + 16;
  229.                     eraserect(therect);
  230.                     drawitem(themenu, - 1, therect);
  231.                 end;
  232.                 
  233.                 therect.top := menurect.top + 16 * (fixedlist + 1);
  234.                 therect.bottom := menurect.bottom - 16;
  235.                 scrollrect(therect, 0, - 16, theregion);
  236.                 
  237.                 therect := theregion^^.rgnbbox;
  238.                 disposergn(theregion);
  239.                 setoffset(getoffset + 1);
  240.                 
  241.                 drawitem(themenu, getoffset + getlength - 1, therect);
  242.                 
  243.                 if getoffset + getlength <> getsize then
  244.                     setflags(3)
  245.                 else begin
  246.                     therect.top := menurect.bottom - 16;
  247.                     therect.bottom := menurect.bottom;
  248.                     eraserect(therect);
  249.                     drawitem(themenu, getsize, therect);
  250.                     setflags(1);
  251.                 end;
  252.             
  253.             end;
  254.             
  255.             repeat until tickcount >= thetime;
  256.         
  257.         end;
  258.     
  259. (******************************************************************)
  260.     
  261.     procedure menuchoose(themenu : menuhandle; static menurect : rect;
  262.                     hitpoint : point; var theitem : integer);
  263.         
  264.         var
  265.             newitem            :    integer;
  266.             therect            :    rect;
  267.         
  268.         begin
  269.             
  270.             if (hitpoint.v < menurect.top)
  271.                             or (hitpoint.h < menurect.left)
  272.                             or (hitpoint.h > menurect.right) then
  273.                 newitem := 0
  274.             else begin
  275.                 
  276.                 newitem := (16 + hitpoint.v - menurect.top) div 16;
  277.                 
  278.                 if (newitem > getlength) and (getflags div 2 = 0) then
  279.                     newitem := 0
  280.                 else if (newitem >= getlength) and (getflags div 2 = 1) then begin
  281.                     scrollmenu(themenu, menurect, - 1);
  282.                     newitem := 0;
  283.                 end else if (newitem = fixedlist + 1) and (getflags mod 2 = 1) then begin
  284.                     scrollmenu(themenu, menurect, 1);
  285.                     newitem := 0;
  286.                 end;
  287.                 
  288.                 if newitem > fixedlist then
  289.                     newitem := newitem + getoffset;
  290.                 
  291.                 if (newitem = 3) or (newitem = 6) then
  292.                     newitem := 0
  293.                 else if (newitem = 5) and (getsize = fixedlist) then
  294.                     newitem := 0;
  295.                 
  296.             end;
  297.             
  298.             if newitem <> theitem then begin
  299.                 
  300.                 therect.left := menurect.left;
  301.                 therect.right := menurect.right;
  302.                 
  303.                 if theitem > 0 then begin
  304.                     therect.bottom := menurect.top + 16 * theitem;
  305.                     if theitem > fixedlist then
  306.                         therect.bottom := therect.bottom - 16 * getoffset;
  307.                     therect.top := therect.bottom - 16;
  308.                     invertrect(therect);
  309.                 end;
  310.                 
  311.                 if newitem > 0 then begin
  312.                     therect.bottom := menurect.top + 16 * newitem;
  313.                     if newitem > fixedlist then
  314.                         therect.bottom := therect.bottom - 16 * getoffset;
  315.                     therect.top := therect.bottom - 16;
  316.                     invertrect(therect);
  317.                 end;
  318.             
  319.             end;
  320.             
  321.             theitem := newitem;
  322.         
  323.         end;
  324.     
  325. (******************************************************************)
  326.     
  327.     function itemsize(themenu : menuhandle;
  328.                     theitem : integer) : integer;
  329.         
  330.         var
  331.             thestring        :    str255;
  332.         
  333.         begin
  334.             
  335.             if theitem <= fixedlist then
  336.                 getitem(themenu, theitem, thestring)
  337.             else with gethandle^^.appl[theitem - fixedlist] do
  338.                 blockmove(@name, @thestring, 32);
  339.             itemsize := stringwidth(thestring);
  340.         
  341.         end;
  342.     
  343. (******************************************************************)
  344.     
  345.     procedure menusize(themenu : menuhandle);
  346.         
  347.         var
  348.             savedload        :    logical;
  349.             savedfont        :    integer;
  350.             savedsize        :    integer;
  351.             savedface        :    style;
  352.             thewidth            :    integer;
  353.             thecount            :    integer;
  354.             index                :    integer;
  355.             newwidth            :    integer;
  356.             maxheight        :    integer;
  357.         
  358.         begin
  359.             
  360.             savedload := logical(ptr(resload)^);
  361.             setresload(true);
  362.             
  363.             with QDglobals^.theport^ do begin
  364.                 savedfont := txfont;
  365.                 savedsize := txsize;
  366.                 savedface := txface;
  367.             end;
  368.             
  369.             textfont(systemfont);
  370.             textsize(12);
  371.             textface([]);
  372.             
  373.             thewidth := 0;
  374.             thecount := gethandle^^.count + fixedlist;
  375.             
  376.             for index := 1 to thecount do begin
  377.                 newwidth := itemsize(themenu, index);
  378.                 if newwidth > thewidth then
  379.                     thewidth := newwidth;
  380.             end;
  381.             
  382.             if bittst(ptr(rom85), 0) then
  383.                 maxheight := 320
  384.             else with QDglobals^.screenbits.bounds do
  385.                 maxheight := bottom - top - shortpointer(mbarheight)^;                                
  386.             
  387.             with themenu^^ do begin
  388.                 
  389.                 menuheight := 16 * thecount;
  390.                 
  391.                 if bittst(ptr(rom85), 0) then
  392.                     maxheight := 304
  393.                 else with QDglobals^.screenbits.bounds do
  394.                     maxheight := bottom - top - 16
  395.                                     - shortpointer(mbarheight)^;                                
  396.                 
  397.                 if menuheight > maxheight then
  398.                     menuheight := maxheight - (maxheight mod 16);
  399.                 
  400.                 menuwidth := thewidth + 16;
  401.                 
  402.                 setsize(thecount);
  403.                 setlength(menuheight div 16);
  404.                 
  405.             end;
  406.             
  407.             textface(savedface);
  408.             textsize(savedsize);
  409.             textfont(savedfont);
  410.             
  411.             setresload(savedload);
  412.         
  413.         end;
  414.     
  415. (******************************************************************)
  416.     
  417. end.
  418.     
  419. (******************************************************************)
  420.